home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-09
/
cdpro11c.zip
/
CD_PRO.CLA
< prev
next >
Wrap
Text File
|
1993-01-15
|
22KB
|
548 lines
PROGRAM
INCLUDE('STD_KEYS.CLA')
INCLUDE('CTL_KEYS.CLA')
INCLUDE('ALT_KEYS.CLA')
INCLUDE('SHF_KEYS.CLA')
REJECT_KEY EQUATE(CTRL_ESC)
ACCEPT_KEY EQUATE(CTRL_ENTER)
TRUE EQUATE(1)
FALSE EQUATE(0)
MAP
PROC(G_OPENFILES)
PROC(G_OPENFILES2)
proc( LPM_Font )
module( 'LPM_Font.BIN' ), binary
proc( LoadFont )
func( CheckVideo ), long
proc( ClearFont )
.
!* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
MODULE('CD_PRO01')
PROC(MAIN) !Ultimate CDROM Manager
. !Size is 2,141
MODULE('COMMAND1')
PROC(COMMAND) !Execute Command
. !Size is 1,056
MODULE('DISPFILE')
PROC(DISPFILE)
. !Size is 3,375
MODULE('DOSTOOL3'),BINARY
PROC(BROWSE) !TYPE TEXT FILE TO PRINTER
FUNC(CHK8087),LONG !CHECK 8087 STATUS
PROC(CHPATH) !CHANGE PATH
FUNC(COMMAND_LINE),STRING
FUNC(CURDISK),STRING !GET CURRENT DISK DRIVE
FUNC(CURPATH),STRING !GET CURRENT PATH
PROC(DELFILE) !DELETE A FILE
FUNC(DOSVER),LONG !GET DOS VERSION
FUNC(ENVIRONMENT),STRING
PROC(FINDFIRST) !SEARCH FOR FIRST AND RETURN
PROC(FINDNEXT) !SEARCH FOR NEXT AND RETURN
FUNC(GETATTR),LONG !GET FILE ATTR
FUNC(GETFILSZ),LONG !GET FILE SIZE
FUNC(GETVERFY),LONG !GET VERIFY SWITCH STATUS
PROC(MKPATH) !MAKE NEW PATH
FUNC(PGMPATH),STRING !GET CURRENT PROGRAM PATH
FUNC(PRINTSCN),LONG !PRINT SCREEN ON LPT1
FUNC(PROPER),STRING
FUNC(PRTSTAT),LONG !GET PRINTER STATUS
PROC(RMPATH) !REMOVE PATH
PROC(SETATTR) !SET FILE ATTR ON/OFF
PROC(SETDISK) !SET NEW CURRENT DISK
PROC(SETFIRST) !SEARCH FOR FIRST
PROC(SETVERFY) !SET VERIFY SWITCH
PROC(SPOOL) !Queue a file to printer
. !Size is 3,903
!* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
AREA ! Number 2
OVERLAY
MODULE('CD_PRO02')
PROC(SHO_FN) !Show Filedata By Fn
.
MODULE('CD_PRO11')
PROC(SHO1TBL) !Files on ONE CD
. . !Size is 8,458
OVERLAY
MODULE('CD_PRO12')
PROC(DIRECTORY) !Directory Information Mtnc
.
MODULE('CD_PRO13')
PROC(SHO_DIR)
.
MODULE('UPD_DIR')
PROC(UPD_DIR) !Update Directory Information
. . !Size is 8,311
OVERLAY
MODULE('ABOUT')
PROC(ABOUT)
.
MODULE('CD_PRO05')
PROC(CONFIG) !Configuration
. . !Size is 4,614
OVERLAY
MODULE('CD_PRO06')
PROC(IMPORT_CHK) !Check if They Want to Continue
.
MODULE('CD_PRO08')
PROC(DOS_FMTF) !Convert DOS Text File Listing
.
MODULE('CD_PRO09')
PROC(SPECIAL) !UTILITIES
.
MODULE('IMPORT_I')
PROC(IMPORT_INT)
. . !Size is 8,455
OVERLAY
MODULE('CD_PRO07')
PROC(REPORTS) !Reports
.
MODULE('CH_DUPES')
PROC(CH_DUPES) !Check File List for Duplicat'n
.
MODULE('DUPES')
PROC(DUPES)
.
MODULE('RECREATE')
PROC(RECREATE) !Re-Create File Listing
. . !Size is 7,031
OVERLAY
MODULE('CD_PRO04')
PROC(SEARCH_FORM) !Search for a Phrase
.
MODULE('LONGSEAR')
PROC(LONGSEARCH)
. . !Size is 6,832
END !Area Number 2 !Size is 8,458
!* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
AREA ! Number 4
OVERLAY
MODULE('IMPORTCL')
PROC(IMPORT_FILE) !Import from Text Files
. . !Size is 4,546
OVERLAY
MODULE('COMPFL')
PROC(COMPFL) !Compare File Lists
. . !Size is 4,080
OVERLAY
MODULE('DOS_FMT')
PROC(DOS_FMT)
. . !Size is 3,965
OVERLAY
MODULE('RECRFILE')
PROC(REC_REPORT)
. . !Size is 3,949
OVERLAY
MODULE('CD_PRO10')
PROC(FORMAT_CFG) !FILE FORMAT CONFIGURATION
. . !Size is 3,127
OVERLAY
MODULE('CD_PRO14')
PROC(SEARCH)
.
MODULE('SEARCH')
PROC(SEARCH2)
. . !Size is 3,406
OVERLAY
MODULE('CD_PRO03')
PROC(VIEW_FILE) !Update Filedata
.
MODULE('VIEWGIF')
PROC(VIEWGIF) !Call VPIC to View a GIF
. . !Size is 3,838
OVERLAY
MODULE('PRE_REMO')
PROC(PRE_REMOVE)
.
MODULE('REMOVEDR')
PROC(REMOVE_DIR)
. . !Size is 4,473
OVERLAY
MODULE('CD_PRO16')
PROC(CORRECT_DATE)
.
MODULE('CHKDATE')
PROC(CHKDATE)
. . !Size is 3,570
OVERLAY
MODULE('CDLOOKUP')
PROC(LOOKUPCD)
PROC(UPD_DRIVES)
.
MODULE('UNIQUE')
PROC(UNIQUE)
. . !Size is 3,421
OVERLAY
MODULE('PRE_BUIL')
PROC(PRE_BUILD) !Re-Build Key Information
.
MODULE('SHK_STR')
PROC(SHK_STR)
. . !Size is 1,916
END !Area Number 4 !Size is 4,546
!* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
AREA ! Number 5
OVERLAY
MODULE('FF_UPD')
PROC(FF_UPD) !File List Format Update
.
MODULE('INCRSTR')
FUNC(INCRSTR),STRING
. . !Size is 2,679
OVERLAY
MODULE('CD_PRO15')
PROC(FIND_DIR) !Choose CD and Directory
. . !Size is 2,366
OVERLAY
MODULE('ZIPVIEW')
PROC(ZIPVIEW)
. . !Size is 3,913
OVERLAY
MODULE('CHK_FLP')
PROC(CHK_FLP) !Check for files on floppy
.
MODULE('ELIM')
FUNC(ELIM),STRING
.
MODULE('FMT_FUNC')
FUNC(FMT_FUNC),STRING !Return Format Based on Data
PROC(SHOW_FMT)
. . !Size is 3,841
END !Area Number 5 !Size is 3,913
!* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
END !MAP !Size is 38,099
FILEDATA FILE,PRE(FIL),CREATE,RECLAIM,NAME(FILE_1)
BY_FN KEY(FIL:FQ,FIL:FN,FIL:DIRNUM),NOCASE,OPT
BY_CD KEY(FIL:DN_CD,FIL:FN),DUP,NOCASE,OPT
BY_DIR KEY(FIL:DIRNUM,FIL:FN),NOCASE,OPT
FMEMO MEMO(230)
RECORD RECORD
FQ STRING(9)
FN STRING(12)
FS LONG !File Size
FDATE LONG !File Date
FDATA STRING(48)
DIRNUM GROUP
DN_CD STRING(2)
DN_DIR STRING(2)
.
. .
GROUP,OVER(FIL:FMEMO)
FIL_MEMO_ROW STRING(46),DIM(5)
.
DIRECTRY FILE,PRE(DIR),CREATE,RECLAIM,NAME(FILE_2)
BY_DIRECTORY KEY(DIR:CD,DIR:DIRECTORY),NOCASE,OPT
BY_DIRNUM KEY(DIR:DIRNUM),NOCASE,OPT
!JUST_CD KEY(DIR:CD),DUP,NOCASE,OPT
RECORD RECORD
DIRECTORY STRING(32) !where it is
DIRNUM GROUP
DN_CD STRING(2)
DN_DIR STRING(2)
.
CD STRING(15)
DESCRIPTION STRING(40)
. .
CONFIG FILE,PRE(CON),CREATE,RECLAIM,NAME(FILE_3)
RECORD RECORD
DRIVE STRING(1) !CD-ROM Drive
DEFCOMMAND STRING(20) !Default Command
NONSTANDARD STRING(10) !Non-Standard Characters
DEFCD STRING(15) !Default CD-ROM
GIFVIEWER STRING(8) !GIF Viewer
GIFVIEWOPT STRING(20) !Options for GIF VIEWER
ARJVIEWER STRING(15) !ARJ File Viewer
ZIPVIEWER STRING(15)
LZHVIEWER STRING(15)
ARCVIEWER STRING(15)
TEXTVIEWER STRING(15)
COPYTARGET STRING(25)
MULTICD STRING(1)
MAINPATH STRING(80)
. .
FLFORMAT FILE,PRE(F),CREATE,RECLAIM,NAME(FILE_4)
BY_TYPE KEY(F:TYPE_FORMAT),NOCASE,OPT
RECORD RECORD
FT BYTE !FILENAME LOCATION
ST BYTE !SIZE LOCATION
DATET BYTE !DATE LOCATION
DT BYTE !DESCRIPTION TAB
SL BYTE !SIZE FIELD SIZE
DATEF STRING(1) !DATE FORMAT
DL BYTE !DESCRIPTION LENGTH
TYPE_FORMAT STRING(10) !WHICH FORMAT IS THIS?
. .
ZVWITHIN FILE,PRE(ZIP),CREATE,RECLAIM,NAME(FILE_5)
BY_FNM KEY(ZIP:FNM),DUP,NOCASE,OPT
RECORD RECORD
FNM STRING(12)
DATA STRING(66)
. .
DRIVES FILE,PRE(DRI),CREATE,RECLAIM,NAME(DRVFILE)
BY_CD KEY(DRI:CD),NOCASE,OPT
RECORD RECORD
LETTER STRING(1)
CD STRING(15)
. .
EJECT('GLOBAL MEMORY VARIABLES')
ACTION SHORT !0 = NO ACTION
!1 = ADD RECORD
!2 = CHANGE RECORD
!3 = DELETE RECORD
!4 = LOOKUP FIELD
GROUP,PRE(MEM)
MESSAGE STRING(30) !Global Message Area
PAGE SHORT !Report Page Number
LINE SHORT !Report Line Number
DEVICE STRING(30) !Report Device Name
SEARCH_FOR STRING(20) !Search for this String
INFILE STRING(30) !File List to be Read In
VALID STRING(8) !String Embedded (Validator)
INCLUSIVE STRING(1) !Include Invalid lines in Outpu
RTYPE1 STRING(1) !Report Type:
CD_OR_DIR STRING(1)
SEARCHTYPE STRING(1) !Search Type: Exact or Close
EXCLUDE1 STRING(15) !Exclude this from reports
EXCLUDE2 STRING(15) !Exclude this from reports
OLD_FORM STRING(10)
NEW_FORM STRING(10)
I_SOURCE STRING(25) !Import Source
I_CD STRING(15) !CD Title
I_FORMAT STRING(10)
I_LOCATION STRING(32)
I_TITLE STRING(40)
SFOUND BYTE
SORDER BYTE !SEARCH ORDER (1,2,3...
.
FILE_1 STRING(70)
FILE_2 STRING(70)
FILE_3 STRING(70)
FILE_4 STRING(70)
FILE_5 STRING(70)
FILE_6 STRING(70)
DRVFILE STRING(70)
CMD_LINE STRING(80)
PRGDRIVE STRING(1)
PRGPATH STRING(60)
OPENING SCREEN HUE(0,7)
ROW(6,1) PAINT(15,9),HUE(15,1)
ROW(21,1) PAINT(5,80),HUE(15,1)
ROW(6,71) PAINT(16,10),HUE(15,1)
ROW(1,1) PAINT(5,80),HUE(15,1)
ROW(6,10) STRING('<219,223{59}>'),HUE(15,7)
ROW(7,10) REPEAT(13);STRING('<219>'),HUE(15,7) .
ROW(6,70) STRING('<1>'),HUE(15,0)
ROW(20,10) STRING('<2>'),HUE(15,0)
ROW(7,70) REPEAT(8);STRING('<219>') .
ROW(15,30) STRING('<237,0{39},219>')
ROW(16,70) REPEAT(4);STRING('<219>') .
ROW(20,11) STRING('<220{59},219>')
ROW(11,29) STRING('LOADING... PLEASE WAIT.')
ROW(14,26) STRING('CD-PRO: The CD-ROM Librarian'),HUE(1,7)
ROW(15,29) STRING('(')
COL(31) STRING(') 1993 Vince Sorensen')
.
TAG TABLE,PRE(TAG)
REC LONG
.
EJECT('CODE SECTION')
CODE
LPM_FONT
OPEN(OPENING)
PRGDRIVE=CURDISK()
PRGPATH =CURPATH()
CMD_LINE=LEFT(UPPER(COMMAND_LINE()))
IF INSTRING('/NONE',CMD_LINE,1)>0
CMD_LINE=''
.
IF INSTRING('/',CMD_LINE,1)
LOOP PP#=1 TO 6
CD_OR_DIR=SUB('FDCLTD',PP#,1)
DO PARSE_CMD
CASE PP#
OF 1
FILE_1=FILE_6
OF 2
FILE_2=FILE_6
OF 3
FILE_3=FILE_6
OF 4
FILE_4=FILE_6
OF 5
FILE_5=FILE_6
OF 6
DRVFILE=FILE_6
.
.
ELSE
IF CLIP(CMD_LINE)<>''
XX#=INSTRING(' ',CMD_LINE,1)
IF INSTRING(',',CMD_LINE,1)<XX# AND INSTRING(',',CMD_LINE,1)>0
XX#=INSTRING(',',CMD_LINE,1)
.
CMD_LINE=RIGHT(CLIP(SUB(CMD_LINE,1,XX#)))
IF SUB(CMD_LINE,80,1)<>':' AND SUB(CMD_LINE,80,1)<>'\'
CMD_LINE=CLIP(LEFT(CMD_LINE)&'\')
ELSE
CMD_LINE=LEFT(CMD_LINE)
..
FILE_1=CLIP(CMD_LINE)&'PROFILES'
FILE_2=CLIP(CMD_LINE)&'PRODIR'
FILE_3=CLIP(CMD_LINE)&'PROCONF'
FILE_4=CLIP(CMD_LINE)&'PROFORM'
FILE_5=CLIP(CMD_LINE)&'TMPDBASE'
DRVFILE=CLIP(CMD_LINE)&'PRODRIVE'
.
IF CLIP(FILE_1)=''
FILE_1='PROFILES'
.
IF CLIP(FILE_2)=''
FILE_2='PRODIR'
.
IF CLIP(FILE_3)=''
FILE_3='PROCONF'
.
IF CLIP(FILE_4)=''
FILE_4='PROFORM'
.
IF CLIP(FILE_5)=''
FILE_5='TMPDBASE'
.
IF CLIP(DRVFILE)=''
DRVFILE='PRODRIVE'
.
IF XX#=0 THEN XX#=1.
CMD_LINE=SUB(COMMAND_LINE(),XX#,80)
HELP('CD_PRO.HLP') !OPEN THE HELP FILE
G_OPENFILES !OPEN OR CREATE FILES
MAIN !Ultimate CDROM Manager
CLOSE(OPENING)
RETURN !EXIT TO DOS
PARSE_CMD ROUTINE
FILE_6=''
IF INSTRING('/'&CD_OR_DIR&'=',CMD_LINE,1)
FILE_6=SUB(CMD_LINE,INSTRING('/'&CD_OR_DIR&'=',CMD_LINE,1)+3,70)
XX#=INSTRING(' ',FILE_6,1)
IF INSTRING(',',FILE_6,1)<XX# AND INSTRING(',',FILE_6,1)>0
XX#=INSTRING(',',FILE_6,1)
.
IF XX#<2
FILE_6=''
ELSE
FILE_6=SUB(FILE_6,1,XX#)
.
.
CD_OR_DIR='D'
EXIT
G_OPENFILES PROCEDURE !OPEN FILES & CHECK FOR ERROR
CODE
G_OPENFILES2(FILEDATA) !CALL OPEN FILE PROCEDURE
G_OPENFILES2(CONFIG) !CALL OPEN FILE PROCEDURE
IF RECORDS(CONFIG)=0
DRIVE='F'
MAINPATH=''
DEFCOMMAND='COPY'
GIFVIEWER='VPIC -A'
TEXTVIEWER='LIST'
ZIPVIEWER='PKZIP -V'
ADD(CONFIG)
.
G_OPENFILES2(FLFORMAT) !CALL OPEN FILE PROCEDURE
G_OPENFILES2(DIRECTRY) !CALL OPEN FILE PROCEDURE
REMOVE(ZVWITHIN)
G_OPENFILES2(ZVWITHIN) !CALL OPEN FILE PROCEDURE
G_OPENFILES2(DRIVES) !CALL OPEN FILE PROCEDURE
G_OPENFILES2 PROCEDURE(G_FILE) !OPEN EACH FILE & CHECK ERROR
G_FILE EXTERNAL,FILE
FILE_NAME STRING(64)
CODE
FILE_NAME = NAME(G_FILE)
SHOW(25,1,CENTER('OPENING FILE: ' & CLIP(FILE_NAME),80)) !DISPLAY FILE NAME
OPEN(G_FILE) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REBUILT
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ' & CLIP(FILE_NAME),80))
BUILD(G_FILE) ! CALL THE BUILD PROCEDURE
IF ERROR() ! ON UNNEXPECTED ERROR
LOOP ! STOP EXECUTION
STOP('Cannot Build ' & FILE_NAME & ' - Error: ' & ERROR())
.
.
BLANK(25,1,1,80) ! BLANK THE MESSAGE
OF 2 !IF NOT FOUND,
CREATE(G_FILE) ! CREATE
IF ERROR() !STOP ON UNNEXPECTED ERROR
LOOP
STOP('Cannot Create ' & FILE_NAME & ' - Error: ' & ERROR())
. .
OF 73 ! MEMO FILE NOT FOUND
LOOP ! STOP EXECUTION
STOP('Cannot Open Memo File for ' & FILE_NAME & ERROR())
.
ELSE ! ANY OTHER ERROR
LOOP ! STOP EXECUTION
STOP('Cannot Open ' & FILE_NAME & ' - Error: ' & ERROR())
.
. .
LPM_Font procedure
g_EGA group,PRE(G_E) !
gsChar1 string('<255,254,248,240,224,192,128,0,0,0,0,0,0,0>')
gsChar2 string('<255,255,255,255,255,255,255,254,248,240,224,192,128,0>')
.
g_VGA group,PRE(G_V) !
GsChar1 string('<255,254,248,240,224,192,128,0,0,0,0,0,0,0,0,0>' )
GsChar2 string('<255,255,255,255,255,254,254,248,240,224,192,128,0,0,0,0>' )
.
code
XX#=CheckVideo()
execute XX#
LoadFont(1,1,2,G_EGA)
LoadFont(2,1,2,G_VGA)
.
execute XX# ! ·
LoadFont(1,250,1,'<0,0,0,0,0,0,195,255,195,0,0,0,0,0>')
LoadFont(2,250,1,'<0,0,0,0,0,0,0,195,255,195,0,0,0,0,0,0>')
.
execute XX# ! φ
LoadFont(1,237,1,'<255,0,0,124,198,192,192,192,198,124,0,0,0,255>')
LoadFont(2,237,1,'<0,255,0,0,124,198,192,192,192,198,124,0,0,255,0,0>')
.
execute XX# ! (
LoadFont(1,40,1,'<3,6,12,24,48,48,48,48,48,48,24,12,6,3>')
LoadFont(2,40,1,'<0,0,3,12,24,48,48,96,48,48,24,12,3,0,0,0>')
.
execute XX# ! )
LoadFont(1,41,1,'<192,96,48,24,12,12,12,12,12,12,24,48,96,192>')
LoadFont(2,41,1,'<0,0,192,48,24,12,12,6,12,12,24,48,192,0,0,0>')
.
RETURN